home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / msdos / 4utils80.zip / STRINGDA.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-17  |  13KB  |  481 lines
  1. UNIT StringDateHandling;
  2. {$D-,F+} (* I'am using procedural variables! *)
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.        David Frey,         & Tom Bowden
  8.        Urdorferstrasse 30    1575 Canberra Drive
  9.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  10.        Switzerland           USA
  11.  
  12.        Code created using Turbo Pascal 7.0, (c) Borland International 1992
  13.  
  14.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  15.                and change it free of charge, but you may not sell or hire
  16.                this part of 4DESC. The copyright remains in our hands.
  17.  
  18.                If you make any (considerable) changes to the source code,
  19.                please let us know. (send a copy or a listing).
  20.                We would like to see what you have done.
  21.  
  22.                We, David Frey and Tom Bowden, the authors, provide absolutely
  23.                no warranty of any kind. The user of this software takes the
  24.                entire risk of damages, failures, data losses or other
  25.                incidents.
  26.  
  27.  
  28.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  29.  
  30.    This unit provides the string handling and the date/time handling.
  31.  
  32.    ----------------------------------------------------------------------- *)
  33.  
  34. INTERFACE USES Dos;
  35.  
  36. TYPE  DateStr    = STRING[8];  (* 'mm-dd-yy','dd.mm.yy' or 'yy/mm/dd' *)
  37.       TimeStr    = STRING[6];  (* 'hh:mmp' or 'hh:mm'                 *)
  38.  
  39. VAR   DateFormat: DateStr; (* 'mm-dd-yy','dd.mm.yy','yy/mm/dd' or 'ddmmmyy' *)
  40.       TimeFormat: TimeStr; (* 'hh:mmp' or 'hh:mm'                           *)
  41.  
  42. (* String handling routines. The strings can be converted to lower/upper-
  43.    case. National characters will be converted.                           *)
  44.  
  45. FUNCTION  Chars(c: CHAR; Count: BYTE): STRING;
  46. FUNCTION  DownCase(C: CHAR): CHAR;
  47. FUNCTION  DownStr(s: STRING): STRING;
  48. PROCEDURE DownString(VAR s: STRING);
  49. FUNCTION  UpStr(s: STRING): STRING;
  50. PROCEDURE UpString(VAR s: STRING);
  51.  
  52. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  53. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  54.  
  55. (* Date/Time handling routines. Date/Time and Numbers will be formatted
  56.    in accordance with your COUNTRY=-settings in CONFIG.SYS.               *)
  57.  
  58. TYPE  FormDateFunc = FUNCTION (DateRec: DateTime) : DateStr;
  59.       FormTimeFunc = FUNCTION (DateRec: DateTime) : TimeStr;
  60.  
  61. VAR   FormDate : FormDateFunc;
  62.       FormTime : FormTimeFunc;
  63.  
  64.  
  65. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  66. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  67.  
  68. IMPLEMENTATION USES HandleINIFile;
  69.  
  70. CONST MonthName: ARRAY[1..12] OF STRING[3] =
  71.                   ('Jan','Feb','Mar','Apr','May','Jun',
  72.                    'Jul','Aug','Sep','Oct','Nov','Dec');
  73.  
  74. CONST DateSep  : CHAR = '.';
  75.       TimeSep  : CHAR = ':';
  76.       MilleSep : CHAR = '''';
  77.  
  78. VAR   Buffer: ARRAY[0..15] OF CHAR;
  79.       (* Buffer for country code information.
  80.          This buffer may not be moved into GetCountryInfo,
  81.          since MS-DOS needs the address of this buffer!    *)
  82.  
  83. (*-------------------------------------------------------- String-Handling *)
  84. FUNCTION Chars(c: CHAR; Count: BYTE): STRING; ASSEMBLER;
  85. (* Concats Count times the character c *)
  86.  
  87. ASM
  88.  LES DI,@Result
  89.  MOV AL,&Count
  90.  CLD
  91.  STOSB
  92.  MOV CL,AL
  93.  XOR CH,CH
  94.  MOV AL,&c
  95.  REP STOSB
  96. END;
  97.  
  98. FUNCTION  DownCase(C: CHAR): CHAR; ASSEMBLER;
  99. (* Returns the character c in lower case, national characters will not
  100.    be handled correctly. [we will use this function to lowercase file
  101.    names and DOS doesn't like special characters in filenames anyway] *)
  102.  
  103. ASM
  104.   MOV AL,&c
  105.   CMP AL,'A'
  106.   JB  @@9                  (* No conversion below 'A'                     *)
  107.   CMP AL,'Z'
  108.   JA  @@9                  (* Conversion between 'A' and 'Z'              *)
  109.   ADD AL,$20
  110. @@9:
  111. END;                       (* finished. *)
  112.  
  113. FUNCTION  DownStr(s: STRING): STRING; ASSEMBLER;
  114. (* Returns the string s in lower case, national characters will not
  115.    be handled correctly. [we will use this function to lowercase file
  116.    names and DOS doesn't like special characters in filenames anyway] *)
  117.  
  118. ASM
  119.  PUSH DS
  120.  CLD
  121.  LDS SI,s
  122.  LES DI,@Result
  123.  LODSB
  124.  STOSB
  125.  XOR AH,AH
  126.  XCHG AX,CX
  127.  JCXZ @11
  128. @10:
  129.  LODSB
  130.  CMP AL,'A'
  131.  JB  @@9                  (* No conversion below 'A'                     *)
  132.  CMP AL,'Z'
  133.  JA  @@9                  (* Conversion between 'A' and 'Z'              *)
  134.  ADD AL,$20
  135. @@9:
  136.  STOSB
  137.  LOOP @10
  138. @11:
  139.  POP DS
  140. END;
  141.  
  142.  
  143. PROCEDURE DownString(VAR s: STRING);
  144. (* Returns the string s in lower case, national characters will not
  145.    be handled correctly. [we will use this function to lowercase file
  146.    names and DOS doesn't like special characters in filenames anyway] *)
  147.  
  148. VAR i : BYTE;
  149.  
  150. BEGIN
  151.  FOR i := 1 TO Length(s) DO s[i] := DownCase(s[i]);
  152. END;
  153.  
  154.  
  155. FUNCTION  UpStr(s: STRING): STRING; ASSEMBLER;
  156. (* Returns the string s in upper case, national characters will not
  157.    be handled correctly.                                              *)
  158.  
  159. ASM
  160.  PUSH DS
  161.  CLD
  162.  LDS SI,s
  163.  LES DI,@Result
  164.  LODSB
  165.  STOSB
  166.  XOR AH,AH
  167.  XCHG AX,CX
  168.  JCXZ @11
  169. @10:
  170.  LODSB
  171.  CMP AL,'a'
  172.  JB @@9
  173.  CMP AL,'z'
  174.  JA @@9
  175.  SUB AL,20H
  176. @@9:
  177.  STOSB
  178.  LOOP @10
  179. @11:
  180.  POP DS
  181. END;
  182.  
  183. PROCEDURE UpString(VAR s: STRING);
  184. (* Returns the string s in upper case, national characters will not
  185.    be handled correctly.                                              *)
  186.  
  187. VAR l : BYTE;
  188.  
  189. BEGIN
  190.  FOR l := 1 TO Length(s) DO s[l] := UpCase(s[l]);
  191. END;
  192.  
  193. PROCEDURE StripLeadingSpaces(VAR s: STRING);
  194.  
  195. BEGIN
  196.  WHILE (Length(s) > 0) AND (s[1] = ' ') DO Delete(s,1,1);
  197. END;
  198.  
  199. PROCEDURE StripTrailingSpaces(VAR s: STRING);
  200.  
  201. VAR l : BYTE;
  202.  
  203. BEGIN
  204.  l := Length(s);
  205.  WHILE (l>0) AND (s[l] = ' ') DO BEGIN Delete(s,l,1); l := Length(s); END;
  206. END;
  207.  
  208. (*-------------------------------------------------------- Date-Handling *)
  209.  
  210. (* Various Date/Time format utilities to suit national date/time formats *)
  211.  
  212. FUNCTION FormDateEuropean(DateRec: DateTime): DateStr;
  213.  
  214. VAR MonStr, DayStr, YearStr : STRING[2];
  215.     res                     : DateStr;
  216.  
  217. BEGIN
  218.  Str(DateRec.Day:2, DayStr);
  219.  
  220.  Str(DateRec.Month:2, MonStr);
  221.  IF DateRec.Month < 10 THEN MonStr[1] := '0';
  222.  
  223.  DateRec.Year := DateRec.Year MOD 100;
  224.  Str(DateRec.Year:2, YearStr);
  225.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  226.  
  227.  FormDateEuropean := DayStr + DateSep + MonStr + DateSep + YearStr;
  228. END;
  229.  
  230. FUNCTION FormDateUS(DateRec: DateTime): DateStr;
  231.  
  232. VAR MonStr, DayStr, YearStr : STRING[2];
  233.     res                     : DateStr;
  234.  
  235. BEGIN
  236.  Str(DateRec.Day:2, DayStr);
  237.  IF DateRec.Day < 10 THEN DayStr[1] := '0';
  238.  
  239.  Str(DateRec.Month:2, MonStr);
  240.  
  241.  DateRec.Year := DateRec.Year MOD 100;
  242.  Str(DateRec.Year:2, YearStr);
  243.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  244.  
  245.  FormDateUS := MonStr + DateSep + DayStr + DateSep + YearStr;
  246. END;
  247.  
  248. FUNCTION FormDateJapanese(DateRec: DateTime): DateStr;
  249.  
  250. VAR MonStr, DayStr, YearStr : STRING[2];
  251.     res                     : DateStr;
  252.  
  253. BEGIN
  254.  Str(DateRec.Day:2, DayStr);
  255.  IF (DateRec.Day < 10) THEN DayStr[1] := '0';
  256.  
  257.  Str(DateRec.Month:2, MonStr);
  258.  IF (DateRec.Month < 10) THEN MonStr[1] := '0';
  259.  
  260.  DateRec.Year := DateRec.Year MOD 100;
  261.  Str(DateRec.Year:2, YearStr);
  262.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  263.  
  264.  FormDateJapanese := YearStr + DateSep + MonStr + DateSep + DayStr;
  265. END;
  266.  
  267. FUNCTION FormDateMyOwn(DateRec: DateTime): DateStr;
  268.  
  269. VAR DayStr, YearStr : STRING[2];
  270.     res             : DateStr;
  271.  
  272. BEGIN
  273.  Str(DateRec.Day:2, DayStr);
  274.  
  275.  DateRec.Year := DateRec.Year MOD 100;
  276.  Str(DateRec.Year:2, YearStr);
  277.  IF DateRec.Year < 10 THEN YearStr[1] := '0';
  278.  
  279.  FormDateMyOwn := DayStr + MonthName[DateRec.Month] + YearStr;
  280. END;
  281.  
  282. FUNCTION FormTime12(DateRec: DateTime): TimeStr;
  283.  
  284. VAR HourStr, MinStr, SecStr : STRING[2];
  285.     amflag                  : CHAR;
  286.     res                     : TimeStr;
  287.  
  288. BEGIN
  289.  IF DateRec.Hour < 12 THEN amflag := 'a'
  290.                       ELSE BEGIN amflag := 'p'; DEC(DateRec.Hour,12); END;
  291.  Str(DateRec.Hour:2,HourStr);
  292.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  293.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  294.  
  295.  FormTime12 := HourStr + TimeSep + MinStr + amflag;
  296. END;
  297.  
  298. FUNCTION FormTime24(DateRec: DateTime): TimeStr;
  299.  
  300. VAR HourStr, MinStr, SecStr : STRING[2];
  301.     res                     : TimeStr;
  302.  
  303. BEGIN
  304.  Str(DateRec.Hour:2,HourStr);
  305.  Str(DateRec.Min :2,MinStr ); IF DateRec.Min < 10 THEN MinStr[1] := '0';
  306.  Str(DateRec.Sec :2,SecStr ); IF DateRec.Sec < 10 THEN SecStr[1] := '0';
  307.  
  308.  FormTime24 := HourStr + TimeSep + MinStr;
  309. END;
  310.  
  311. (*------------------------------------------------ Formatting of numbers *)
  312.  
  313. FUNCTION FormattedIntStr(nr: WORD;minlength: BYTE): STRING;
  314. (* Converts an integer number into a string of the form xxx'xxx...') *)
  315.  
  316. VAR helpstr  : STRING;
  317.     millestr : STRING[4];
  318.     n,i      : BYTE;
  319.  
  320. BEGIN
  321.  IF nr = 0 THEN FormattedIntStr := Chars(' ',minlength-1)+'0'
  322.  ELSE
  323.   BEGIN
  324.    helpstr := '';
  325.    n := nr DIV 1000; nr := nr MOD 1000;
  326.    IF n > 0 THEN
  327.     BEGIN
  328.      Str(n,helpstr);
  329.      helpstr := millestr+helpstr+MilleSep;
  330.     END;
  331.  
  332.    IF n = 0 THEN Str(nr,millestr)
  333.    ELSE
  334.     BEGIN
  335.      Str(nr:3,millestr);
  336.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  337.     END;
  338.    helpstr:=helpstr+millestr;
  339.    n := Length(helpstr);
  340.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  341.  
  342.    FormattedIntStr := helpstr;
  343.   END;
  344. END;
  345.  
  346. FUNCTION FormattedLongIntStr(nr: LONGINT;minlength: BYTE): STRING;
  347. (* Converts a long integer number into a string of the form xxx'xxx...') *)
  348.  
  349. VAR helpstr  : STRING;
  350.     millestr : STRING[4];
  351.     n,i      : WORD;
  352.  
  353. BEGIN
  354.  IF nr = 0 THEN FormattedLongIntStr := Chars(' ',minlength-1)+'0'
  355.  ELSE
  356.   BEGIN
  357.    helpstr := '';
  358.  
  359.    n := nr DIV 1000000; nr := nr MOD 1000000;
  360.    IF n > 0 THEN
  361.     BEGIN
  362.      Str(n,millestr); helpstr := millestr+MilleSep;
  363.     END;
  364.  
  365.    n := nr DIV 1000; nr := nr MOD 1000;
  366.    IF n > 0 THEN
  367.     BEGIN
  368.      Str(n:3,millestr);
  369.      IF helpstr > '' THEN
  370.       BEGIN
  371.        FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  372.        helpstr := helpstr+millestr+MilleSep;
  373.       END
  374.      ELSE helpstr := millestr+MilleSep;
  375.     END;
  376.  
  377.    IF n = 0 THEN Str(nr,millestr)
  378.    ELSE
  379.     BEGIN
  380.      Str(nr:3,millestr);
  381.      FOR i := 1 TO 3 DO IF millestr[i] = ' ' THEN millestr[i] := '0';
  382.     END;
  383.    helpstr:=helpstr+millestr;
  384.    n := Length(helpstr);
  385.    IF n < minlength THEN helpstr := Chars(' ',minlength-n)+helpstr;
  386.  
  387.    FormattedLongIntStr := helpstr;
  388.   END;
  389. END;
  390.  
  391. (*------------------------------------------------------- Initialisation *)
  392.  
  393. PROCEDURE GetCountryInfo;
  394.  
  395. VAR Regs  : Registers;
  396.  
  397. BEGIN
  398.  WITH Regs DO
  399.   BEGIN
  400.    ah := $38; (* Get / Set Country Data *)
  401.    al := $00;
  402.    ds := Seg(Buffer); dx := Ofs(Buffer); (* Address of Buffer *)
  403.   END;
  404.  MsDos(Regs);
  405.  
  406.  IF Regs.Flags AND FCarry = 0 THEN
  407.   BEGIN
  408.    MilleSep := Buffer[ 7];
  409.    DateSep  := Buffer[11];
  410.    TimeSep  := Buffer[13];
  411.   END;
  412.  
  413.  CASE Ord(Buffer[0]) OF
  414.   0 : BEGIN
  415.        FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  416.        FormTime := FormTime12;       TimeFormat := 'hh'+TimeSep+'mmp';
  417.       END;
  418.   1 : BEGIN
  419.        FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  420.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  421.       END;
  422.   2 : BEGIN
  423.        FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  424.        FormTime := FormTime24;       TimeFormat := 'hh'+TimeSep+'mm';
  425.       END;
  426.  ELSE
  427.   BEGIN
  428.    FormDate := FormDateEuropean;     DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  429.    FormTime := FormTime24;           TimeFormat := 'hh'+TimeSep+'mm';
  430.   END;
  431.  END; (* CASE *)
  432. END;
  433.  
  434. PROCEDURE EvaluateINIFileSettings;
  435.  
  436. VAR s : STRING[7];
  437.  
  438. BEGIN
  439.  IF INIFileExists THEN
  440.   BEGIN
  441.    MilleSep := ReadSettingsChar('date & time formats','millesep',MilleSep);
  442.    TimeSep  := ReadSettingsChar('date & time formats','timesep' ,TimeSep);
  443.    DateSep  := ReadSettingsChar('date & time formats','datesep' ,DateSep);
  444.  
  445.    s := ReadSettingsString('date & time formats','dateformat','ddmmmyy');
  446.    IF s = 'ddmmyy' THEN
  447.     BEGIN
  448.      FormDate := FormDateEuropean; DateFormat := 'dd'+DateSep+'mm'+DateSep+'yy';
  449.     END
  450.    ELSE
  451.    IF s = 'mmddyy' THEN
  452.     BEGIN
  453.      FormDate := FormDateUS;       DateFormat := 'mm'+DateSep+'dd'+DateSep+'yy';
  454.     END
  455.    ELSE
  456.    IF s = 'yymmdd' THEN
  457.     BEGIN
  458.      FormDate := FormDateJapanese; DateFormat := 'yy'+DateSep+'mm'+DateSep+'dd';
  459.     END
  460.    ELSE
  461.     BEGIN
  462.      FormDate := FormDateMyOwn;    DateFormat := 'ddmmmyy';
  463.     END;
  464.  
  465.    s := ReadSettingsString('date & time formats','timeformat','24');
  466.    IF s = '12' THEN
  467.     BEGIN
  468.      FormTime := FormTime12; TimeFormat := 'hh'+TimeSep+'mmp';
  469.     END
  470.    ELSE
  471.     BEGIN
  472.      FormTime := FormTime24; TimeFormat := 'hh'+TimeSep+'mm';
  473.     END;
  474.   END;
  475. END;
  476.  
  477. BEGIN
  478.  GetCountryInfo;
  479.  IF INIFileExists THEN EvaluateINIFileSettings;
  480. END.
  481.